home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / TCPExample / PNL Libraries / MyConnections.p < prev    next >
Text File  |  1997-06-23  |  21KB  |  889 lines

  1. unit MyConnections;
  2.  
  3. { MyConnections © Peter N Lewis, 1993-96 }
  4.  
  5. interface
  6.  
  7.     uses
  8.         Types, TCPTypes, MyTypes, OpenTransport, MyTransport, MyAssertions;
  9.  
  10.     const
  11.         tooManyConnections = -23099;
  12.         timeoutError = -23098;
  13.         failedToOpenError = -23097;
  14.         k_max_found_addresses = 10;
  15.  
  16. { Sequence: }
  17. { new(obj) }
  18. { oe:=obj.Create }
  19. { if oe=noErr then begin }
  20. {   do stuff}
  21. { end; }
  22. { obj.timetodie := true } { Don't call Destroy yourself }
  23.  
  24.     type
  25.         ConnectionBaseObject = object
  26.                 timetodie: boolean; { Set this to have Destroy called at the end of HandleConnection }
  27.                 connection_index: integer; { private! }
  28.                 closedone: boolean;
  29.                 heartbeat_period: longint; { set to <=0 to disable heartbeats }
  30.                 heartbeat_time: longint; { set to time of next Heartbeat, it is automatically incrememnted by the period }
  31. { To enable heartbeats, set heartbeat_time to TickCount, and heartbeat_period to the period in ticks }
  32.                 timeout_time: longint; { set to time to timeout TickCount }
  33.                 dnr_token: Ptr;
  34.                 hack_do_test_bad_connections: boolean;
  35.                 hack_test_bad_connections: boolean;
  36.                 function Create: OSStatus;
  37.                 procedure Destroy;
  38.                 procedure Heartbeat;
  39.                 procedure Failed (oe: OSStatus);
  40.                 procedure Close;
  41.                 procedure HandleConnection;
  42.                 procedure SetHeartBeat(period: longint);
  43.             end;
  44.         NameSearchObject = object(ConnectionBaseObject)
  45.                 ip: longint;
  46.                 procedure HandleConnection;
  47.                 override;
  48.                 procedure FindName (hostIP: longint);
  49.                 procedure FoundName (name: Str255; error: OSStatus);
  50.             end;
  51.         AddressSearchObject = object(ConnectionBaseObject)
  52.                 object_host: Str255;
  53.                 addresses: array[1..k_max_found_addresses] of ipAddr;
  54.                 procedure HandleConnection;
  55.                 override;
  56.                 procedure FindAddress (hostName: Str255);
  57.                 procedure FoundAddress (ip: longint);
  58.             end;
  59.         ListenerObject = object(ConnectionBaseObject)
  60.                 listener: Ptr;
  61.                 localport: ipPort;
  62.                 function Create: OSStatus;
  63.                 override;
  64.                 procedure Destroy;
  65.                 override;
  66.                 function CreateListener(buffersize:longint; port:ipPort; listeners:integer): OSStatus;
  67.                 procedure HandleConnection;
  68.                 override;
  69.                 procedure ConnectionAvailable( connection: TransportRef ); { override this - do not call it! }
  70.             end;
  71.         UDPObject = object(ConnectionBaseObject)
  72.                 tref: TransportUDPRef;
  73.                 localport: ipPort;
  74.                 function Create: OSStatus;
  75.                 override;
  76.                 function CreatePort (buffersize: longint; port: ipPort): OSStatus;
  77.                 procedure Close;
  78.                 override;
  79.                 procedure Destroy;
  80.                 override;
  81.                 procedure HandleConnection;
  82.                 override;
  83.                 procedure PacketAvailable (remoteip: ipAddr; remoteport: ipPort; datap: Ptr; datalen: integer);
  84.                 procedure PacketsAvailable (count: integer);
  85.                 function SendPacket (remoteip: longint; remoteport: ipPort; datap: Ptr; datalen: integer; checksum: boolean): OSStatus;
  86.             end;
  87.         statusType = (CS_None, CS_Opening, CS_Established, CS_Closing);
  88.         ConnectionObject = object(ConnectionBaseObject)
  89.                 tref: TransportRef;
  90.                 status: statusType;
  91.                 ourport: ipPort;
  92.                 input_buffer: Handle;
  93.                 output_buffer: Handle;
  94.                 transfer_error:OSStatus;
  95.                 do_send_close: Boolean;
  96.                 function Create: OSStatus;
  97.                 override;
  98.                 procedure Destroy;
  99.                 override;
  100.                 procedure HandleConnection;
  101.                 override;
  102.                 procedure NewConnection (actve: boolean; buffersize: longint; localport: ipPort; remotehost: Str255);
  103.                 procedure NewPassiveConnection (buffersize: longint; localport: ipPort);
  104.                 procedure NewActiveConnection (buffersize: longint; remotehost: Str255);
  105.                 procedure NewExistingConnection(newtref: TransportRef);
  106.                 procedure Close;
  107.                 override;
  108.                 procedure BeginConnection; { override these }
  109.                 procedure Established;
  110.                 procedure Closing;
  111.                 procedure CharsAvailable;
  112.                 procedure DoTransfer;
  113.                 procedure SendString (s: Str255);
  114.                 procedure SendData(datap: Ptr; len: longint);
  115.             end;
  116.         LineConnectionObject = object(ConnectionObject)
  117.                 crlf: CRLFTypes;
  118.                 last_check: longint; { last input_buffer size, dont recheck unless it changes }
  119.                 function Create: OSStatus;
  120.                 override;
  121.                 procedure CharsAvailable;
  122.                 override;
  123.                 procedure SendLine (s: Str255);
  124.                 procedure LineAvailable (line: Str255);
  125.                 procedure CheckLineAvailable; { You can override this and use input_buffer yourself }
  126.             end;
  127.  
  128. {$ifc not do_debug}
  129. {$definec AssertValidConnection(c) }
  130. {$elsec}
  131. {$definec AssertValidConnection(c) AssertValidConnectionCode(c)}
  132. {$endc}
  133.  
  134. {$ifc do_debug}
  135.     procedure AssertValidConnectionCode( connection: ConnectionBaseObject );
  136. {$endc}
  137.  
  138.     procedure StartupConnections;
  139.     procedure FinishConnections;
  140.     function ValidConnection( connection: ConnectionBaseObject ): boolean;
  141.  
  142. implementation
  143.  
  144.     uses
  145.         Devices, TextUtils, Memory, Events,
  146.         MyLowLevel, 
  147.         DNR, MyStrings, MyMemory, MyMathUtils, MyIPStrings, TCPUtils, MyStartup;
  148.  
  149. {$ifc undefined objects_are_handles}
  150. {$setc objects_are_handles := 1}
  151. {$endc}
  152.  
  153.     const
  154.         TCPCMagic = 'TCPC';
  155.         TCPCBadMagic = 'badc';
  156.  
  157.     const  { Tuning parameters }
  158.         connections_max = 128;
  159.         TO_FindAddress = 40 * second_in_ticks;
  160.         TO_FindName = 40 * second_in_ticks;
  161.         TO_ActiveOpen = 20 * second_in_ticks;
  162.         TO_Closing = longint(2) * minute_in_ticks;
  163.         TO_PassiveOpen = longint(1) * 365 * day_in_ticks;  { One years should be safe enough right? :-) }
  164.  
  165.     type
  166.         myHostInfo = record
  167.                 hi: hostInfo;
  168.                 done: SignedByte;
  169.             end;
  170.         myHIP = ^myHostInfo;
  171.  
  172. {$ifc do_debug}
  173.     var
  174.         startup_check: integer;
  175. {$endc}
  176.  
  177.     var
  178.         max_connections: integer;
  179.         connections: array[1..connections_max] of ConnectionBaseObject;
  180.         quiting: boolean;
  181.  
  182.     function ValidConnection( connection: ConnectionBaseObject ): boolean;
  183.         var
  184.             i: integer;
  185.     begin
  186.         ValidConnection := false;
  187.         for i := 1 to max_connections do begin
  188.             if connections[i] = connection then begin
  189.                 ValidConnection := true;
  190.                 leave;
  191.             end;
  192.         end;
  193.     end;
  194.     
  195. {$ifc do_debug}
  196.     procedure AssertValidConnectionCode( connection: ConnectionBaseObject );
  197.     begin
  198.         Assert( ValidConnection( connection ) );
  199.     end;
  200. {$endc}
  201.     
  202.     function ConnectionBaseObject.Create: OSStatus;
  203.         var
  204.             i: integer;
  205.             err: OSStatus;
  206.     begin
  207.         AssertDidStartup( startup_check );
  208. {$ifc objects_are_handles}
  209.         LockHigh(Handle(self));
  210. {$endc}
  211.  
  212.         hack_test_bad_connections := false;
  213.         hack_do_test_bad_connections := false;
  214.  
  215.         dnr_token := nil;
  216.         err := noErr;
  217.         if quiting then begin
  218.             err := -12;
  219.         end;
  220.         if err = noErr then begin
  221.             err := OpenTransportSystem;
  222.         end;
  223.         if err = noErr then begin
  224.             i := 1;
  225.             while (i <= connections_max) & (connections[i] <> nil) do begin
  226.                 i := i + 1;
  227.             end;
  228.             if i <= connections_max then begin
  229.                 timetodie := false;
  230.                 connection_index := i;
  231.                 max_connections := Max( max_connections, i );
  232.                 connections[i] := self;
  233.                 heartbeat_period := -1;
  234.                 heartbeat_time := 0;
  235.                 timeout_time := maxLongInt;
  236.                 closedone := false;
  237.             end else begin
  238.                 connection_index := -1;
  239.                 err := tooManyConnections;
  240.             end;
  241.         end;
  242.         Create := err;
  243.     end;
  244.  
  245.     procedure ConnectionBaseObject.Destroy;
  246.     begin
  247.         if connection_index > 0 then begin
  248.             connections[connection_index] := nil;
  249.         end;
  250.         TransportAbortDNR(dnr_token);
  251.         dispose(self);
  252.     end;
  253.  
  254.     procedure ConnectionBaseObject.Heartbeat;
  255.     begin
  256.     end;
  257.  
  258.     procedure ConnectionBaseObject.Failed (err: OSStatus);
  259.     begin
  260. {$unused(err)}
  261.         timetodie := true;
  262.     end;
  263.  
  264.     procedure ConnectionBaseObject.Close;
  265.     begin
  266.         closedone := true;
  267.     end;
  268.  
  269.     procedure ConnectionBaseObject.SetHeartBeat(period: longint);
  270.         var
  271.             time: longint;
  272.     begin
  273.         time := TickCount;
  274.         if (heartbeat_period <= 0) or (period < 0) then begin
  275.             heartbeat_time := time;
  276.         end;
  277.         heartbeat_period := period;
  278.         if heartbeat_time < time then begin
  279.             heartbeat_time := time;
  280.         end;
  281.         if (heartbeat_period > 0) & (heartbeat_time > time + heartbeat_period) then begin
  282.             heartbeat_time := time + heartbeat_period;
  283.         end;
  284.     end;
  285.  
  286.     procedure ConnectionBaseObject.HandleConnection;
  287.         var
  288.             now: longint;
  289.     begin
  290.         now := TickCount;
  291.         if now > timeout_time then begin
  292.             timeout_time := maxLongInt;
  293.             Failed(timeoutError);
  294.         end else if (heartbeat_period > 0) & (now >= heartbeat_time) then begin
  295.             Heartbeat;
  296.             heartbeat_time := heartbeat_time + heartbeat_period;
  297.             if heartbeat_time < now then begin
  298.                 heartbeat_time := now;
  299.             end;
  300.         end;
  301.     end;
  302.  
  303.     procedure AddressSearchObject.FindAddress (hostName: Str255);
  304.         var
  305.             err: OSStatus;
  306.     begin
  307.         err := Create;
  308.         if err = noErr then begin
  309.             object_host := hostName;
  310.             err := TransportNameToAddr(hostName, dnr_token);
  311.             timeout_time := TickCount + TO_FindAddress;
  312.         end;
  313.         if err <> noErr then begin
  314.             Failed(err);
  315.             timetodie := true;
  316.         end;
  317.     end;
  318.  
  319.     procedure AddressSearchObject.FoundAddress (ip: longint);
  320.     begin
  321. {$unused(ip)}
  322.     end;
  323.  
  324.     procedure AddressSearchObject.HandleConnection;
  325.         var
  326.             result: OSStatus;
  327.     begin
  328.         inherited HandleConnection;
  329.         if not timetodie then begin
  330.             TransportGetNameToAddrResult(dnr_token, result, nil, @addresses, k_max_found_addresses);
  331.             if result = noErr then begin
  332.                 FoundAddress(addresses[1]);
  333.                 timetodie := true;
  334.             end else if result <> inProgress then begin
  335.                 Failed(result);
  336.                 timetodie := true;
  337.             end;
  338.         end;
  339.     end;
  340.  
  341.     procedure NameSearchObject.FindName (hostIP: longint);
  342.         var
  343.             err: OSStatus;
  344.     begin
  345.         ip := hostIP;
  346.         err := Create;
  347.         if err = noErr then begin
  348.             err := TransportAddrToName(hostIP, dnr_token);
  349.             timeout_time := TickCount + TO_FindName;
  350.         end;
  351.         if err <> noErr then begin
  352.             Failed(err);
  353.             timetodie := true;
  354.         end;
  355.     end;
  356.  
  357.     procedure NameSearchObject.FoundName (name: Str255; error: OSStatus);
  358.     begin
  359. {$unused(name, error)}
  360.     end;
  361.  
  362.     procedure NameSearchObject.HandleConnection;
  363.         var
  364.             result: OSStatus;
  365.             name:Str255;
  366.     begin
  367.         inherited HandleConnection;
  368.         if not timetodie then begin
  369.             TransportGetAddrToNameResult(dnr_token, result, name);
  370.             if result <> inProgress then begin
  371.                 if result <> noErr then begin
  372.                     IPAddrToString( ip, name );
  373.                 end;
  374.                 FoundName(name, result);
  375.                 timetodie := true;
  376.             end;
  377.         end;
  378.     end;
  379.  
  380.     function ListenerObject.Create: OSStatus;
  381.     begin
  382.         listener := nil;
  383.         localport := 0;
  384.         Create := inherited Create;
  385.     end;
  386.  
  387.     procedure ListenerObject.Destroy;
  388.     begin
  389.         if listener <> nil then begin
  390.             TransportDestroyListener( listener );
  391.         end;
  392.         inherited Destroy;
  393.     end;
  394.  
  395.     function ListenerObject.CreateListener(buffersize:longint; port:ipPort; listeners:integer): OSStatus;
  396.         var
  397.             err: OSStatus;
  398.     begin
  399.         err := Create;
  400.         if err = noErr then begin
  401.             localport := port;
  402.             err := TransportListen( listener, localport, listeners, buffersize);
  403.             timeout_time := maxLongInt;
  404.         end;
  405.         if err <> noErr then begin
  406.             timetodie := true;
  407.         end;
  408.         CreateListener := err;
  409.     end;
  410.     
  411.     procedure ListenerObject.ConnectionAvailable( connection: TransportRef );
  412.     begin
  413.         TransportDestroy( connection );
  414.     end;
  415.     
  416.     procedure ListenerObject.HandleConnection;
  417.         var
  418.             connection:TransportRef;
  419.     begin
  420.         if TransportGetListenerConnection( listener, connection ) = noErr then begin
  421.             ConnectionAvailable( connection );
  422.         end;
  423.         inherited HandleConnection;
  424.     end;
  425.     
  426.     function UDPObject.Create: OSStatus;
  427.     begin
  428.         tref := nil;
  429.         localport := 0;
  430.         Create := inherited Create;
  431.     end;
  432.  
  433.     function UDPObject.CreatePort (buffersize: longint; port: ipPort): OSStatus;
  434.         var
  435.             err: OSStatus;
  436.     begin
  437.         err := Create;
  438.         if err = noErr then begin
  439.             err := TransportUDPOpenPort(tref, port, buffersize);
  440.             localport := port;
  441.             timeout_time := maxLongInt;
  442.         end;
  443.         if err <> noErr then begin
  444.             timetodie := true;
  445.         end;
  446.         CreatePort := err;
  447.     end;
  448.  
  449.     procedure UDPObject.Close;
  450.     begin
  451.         timetodie := true;
  452.         inherited Close;
  453.     end;
  454.  
  455.     procedure UDPObject.Destroy;
  456.     begin
  457.         TransportUDPDestroy(tref);
  458.         inherited Destroy;
  459.     end;
  460.  
  461.     procedure UDPObject.PacketAvailable (remoteip: ipAddr; remoteport: ipPort; datap: Ptr; datalen: integer);
  462.     begin
  463. {$unused(remoteip, remoteport, datap, datalen)}
  464.     end;
  465.  
  466.     procedure UDPObject.PacketsAvailable (count: integer);
  467.         var
  468.             err: OSStatus;
  469.             remoteip: longint;
  470.             remoteport: ipPort;
  471.             datap: Ptr;
  472.             datalen: integer;
  473.     begin
  474. {$unused(count)}
  475.         err := TransportUDPRead (tref, remoteip, remoteport, datap, datalen);
  476.         if err = noErr then begin
  477.             PacketAvailable(remoteip, remoteport, datap, datalen);
  478.             err := TransportUDPReturnBuffer(tref, datap);
  479.         end;
  480.     end;
  481.  
  482.     function UDPObject.SendPacket (remoteip: longint; remoteport: ipPort; datap: Ptr; datalen: integer; checksum: boolean): OSStatus;
  483.     begin
  484.         SendPacket := TransportUDPWrite (tref, remoteip, remoteport, datap, datalen, checksum);
  485.     end;
  486.  
  487.     procedure UDPObject.HandleConnection;
  488.         var
  489.             count: longint;
  490.     begin
  491.         inherited HandleConnection;
  492.         if not timetodie & (tref <> nil) then begin
  493.             count := TransportUDPDatagramsAvailable(tref);
  494.             if count > 0 then begin
  495.                 PacketsAvailable(count);
  496.             end;
  497.         end;
  498.     end;
  499.  
  500.     procedure ConnectionObject.Established;
  501.     begin
  502.     end;
  503.  
  504.     procedure ConnectionObject.Closing;
  505.     begin
  506.         Close;
  507.     end;
  508.  
  509.     procedure ConnectionObject.CharsAvailable;
  510.     begin
  511.     end;
  512.  
  513.     function ConnectionObject.Create: OSStatus;
  514.         var
  515.             err, err2:OSStatus;
  516.     begin
  517.         err := inherited Create;
  518.         status := CS_None;
  519.         transfer_error := noErr;
  520.         do_send_close := false;
  521.         err2 := MNewHandle(input_buffer, 0);
  522.         if err = noErr then begin
  523.             err := err2;
  524.         end;
  525.         err2 := MNewHandle(output_buffer, 0);
  526.         if err = noErr then begin
  527.             err := err2;
  528.         end;
  529.         Create := err;
  530.     end;
  531.     
  532.     procedure ConnectionObject.Destroy;
  533.     begin
  534.         TransportDestroy(tref);
  535.         MDisposeHandle(input_buffer);
  536.         MDisposeHandle(output_buffer);
  537.         inherited Destroy;
  538.     end;
  539.  
  540.     procedure ConnectionObject.SendData(datap: Ptr; len: longint);
  541.         var
  542.             err: OSStatus;
  543.     begin
  544.         if ((status = CS_Established) or (status = CS_Closing)) and not closedone then begin
  545.             err := PtrAndHand(datap, output_buffer, len);
  546.         end else begin
  547.             err := -24;
  548.         end;
  549.         if transfer_error = noErr then begin
  550.             transfer_error := err;
  551.         end;
  552.     end;
  553.  
  554.     procedure ConnectionObject.SendString (s: Str255);
  555.     begin
  556.         SendData(@s[1], length(s));
  557.     end;
  558.  
  559.     procedure ConnectionObject.DoTransfer;
  560.         procedure SetErr(err:OSStatus);
  561.         begin
  562.             if (transfer_error = noErr) then begin
  563.                 transfer_error := err;
  564.             end;
  565.         end;
  566.         var
  567.             err: OSStatus;
  568.             count, len:longint;
  569.     begin
  570.         len := MGetHandleSize(input_buffer);
  571.         count := Min(TransportCharsAvailable(tref), 10240-len);
  572.         if count > 0 then begin
  573.             err := MSetHandleSize(input_buffer, len + count);
  574.             if err = noErr then begin
  575.                 HLock(input_buffer);
  576.                 err := TransportReceive(tref, AddPtrLong(input_buffer^, len), count, count);
  577.                 HUnlock(input_buffer);
  578.                 SetErr(err);
  579.                 SetHandleSize(input_buffer, len + count);
  580.             end;
  581.         end;
  582.  
  583.         len := MGetHandleSize(output_buffer);
  584.         if len > 0 then begin
  585.             HLock(output_buffer);
  586.             err := TransportSend(tref, output_buffer^, len);
  587.             HUnlock(output_buffer);
  588.             SetHandleSize(output_buffer, 0);
  589.             SetErr(err);
  590.         end else if do_send_close then begin
  591.             do_send_close := false;
  592.             timeout_time := TickCount + TO_Closing;
  593.             TransportSendClose(tref);
  594.         end;
  595.     end;
  596.     
  597.     procedure ConnectionObject.BeginConnection;
  598.     begin
  599.     end;
  600.  
  601.     procedure ConnectionObject.NewExistingConnection(newtref: TransportRef);
  602.         var
  603.             err: OSStatus;
  604.     begin
  605.         err := Create;
  606.         tref := newtref;
  607.         if err = noErr then begin
  608.             err := TransportHandleTransfers(tref);
  609.         end;
  610.         if err = noErr then begin
  611.             status := CS_Established;
  612.             ourport := 0;
  613.             timeout_time := maxLongInt;
  614.             BeginConnection;
  615.             Established;
  616.         end else begin
  617.             Failed(err);
  618.         end;
  619.     end;
  620.     
  621.     procedure ConnectionObject.NewConnection (active: boolean; buffersize: longint; localport: ipPort; remotehost: Str255);
  622.         var
  623.             err: OSStatus;
  624.     begin
  625.         tref := nil;
  626.         err := Create;
  627.         if err = noErr then begin
  628.             status := CS_Opening;
  629.             ourport := localport;
  630.             if active then begin
  631.                 err := TransportOpenActiveConnection(tref, remotehost, ourport, buffersize);
  632.                 timeout_time := TickCount + TO_ActiveOpen;
  633.             end else begin
  634.                 err := TransportOpenPassiveConnection(tref, ourport, buffersize);
  635.                 timeout_time := TickCount + TO_PassiveOpen;
  636.             end;
  637.         end;
  638.         if err = noErr then begin
  639.             err := TransportHandleTransfers(tref);
  640.         end;
  641.         if err = noErr then begin
  642.             BeginConnection;
  643.         end else begin
  644.             Failed(err);
  645.             timetodie := true;
  646.         end;
  647.     end;
  648.  
  649.     procedure ConnectionObject.NewPassiveConnection (buffersize: longint; localport: ipPort);
  650.     begin
  651.         NewConnection(false, buffersize, localport, '');
  652.     end;
  653.  
  654.     procedure ConnectionObject.NewActiveConnection (buffersize: longint; remotehost: Str255);
  655.     begin
  656.         NewConnection(true, buffersize, 0, remotehost);
  657.     end;
  658.  
  659.     procedure ConnectionObject.Close;
  660.     begin
  661.         if not closedone and (tref <> nil) then begin
  662.             if MGetHandleSize(output_buffer) > 0 then begin
  663.                 do_send_close := true;
  664.             end else begin
  665.                 timeout_time := TickCount + TO_Closing;
  666.                 TransportSendClose(tref);
  667.             end;
  668.         end;
  669.         closedone := true;
  670.     end;
  671.  
  672.     procedure ConnectionObject.HandleConnection;
  673.         var
  674.             state: TCPStateType;
  675.             result: OSStatus;
  676.     begin
  677.         inherited HandleConnection;
  678.         if not timetodie then begin
  679.             case status of
  680.                 CS_Opening:  begin
  681.                     TransportGetOpenResult(tref, result);
  682.                     if result = noErr then begin
  683.                         status := CS_Established;
  684.                         timeout_time := maxLongInt;
  685.                         Established;
  686.                     end else if result <> inProgress then begin
  687.                         Failed(result);
  688.                         timetodie := true;
  689.                     end;
  690.                 end;
  691.                 CS_Established:  begin
  692.                     DoTransfer;
  693.                     state := TransportGetConnectionState(tref);
  694.                     
  695.                     if hack_test_bad_connections then begin
  696.                         state := T_Dead;
  697.                     end;
  698.                     
  699.                     case state of
  700.                         T_Established:  begin
  701.                             if MGetHandleSize(input_buffer) > 0 then begin
  702.                                 CharsAvailable;
  703.  
  704.                                 if hack_do_test_bad_connections & (band( Random(), 31 ) = 1) then begin 
  705.                                     hack_test_bad_connections := true;
  706.                                 end;
  707.  
  708.                             end;
  709.                         end;
  710.                         T_PleaseClose, T_Closing:  begin
  711.                             if MGetHandleSize(input_buffer) > 0 then begin
  712.                                 CharsAvailable;
  713.                             end else begin
  714.                                 status := CS_Closing;
  715.                                 timeout_time := TickCount + TO_Closing;
  716.                                 Closing;
  717.                             end;
  718.                         end;
  719.                         T_Dead, T_Bored:  begin
  720.                             status := CS_Closing;
  721.                             timeout_time := TickCount + TO_Closing;
  722.                             Closing;
  723.                         end;
  724.                         otherwise
  725.                             ;
  726.                     end;
  727.                 end;
  728.                 CS_Closing:  begin
  729.                     DoTransfer;
  730.                     state := TransportGetConnectionState(tref);
  731.  
  732.                     if hack_test_bad_connections then begin
  733.                         state := T_Dead;
  734.                     end;
  735.                     
  736.                     case state of
  737.                         T_PleaseClose, T_Closing, T_Established:  begin
  738.                             if MGetHandleSize(input_buffer) > 0 then begin
  739.                                 CharsAvailable;
  740.                             end;
  741.                         end;
  742.                         T_Dead, T_Bored:  begin
  743.                             timetodie := true;
  744.                         end;
  745.                         otherwise
  746.                             ;
  747.                     end;
  748.                 end;
  749.                 otherwise
  750.                     ;
  751.             end;
  752.         end;
  753.     end;
  754.  
  755.     function LineConnectionObject.Create: OSStatus;
  756.     begin
  757.         crlf := CL_CRLF;
  758.         last_check := -1;
  759.         Create := inherited Create;
  760.     end;
  761.  
  762.     procedure LineConnectionObject.SendLine (s: Str255);
  763.     begin
  764.         if crlf <> CL_LF then begin
  765.             s := concat(s, cr);
  766.         end;
  767.         if crlf <> CL_CR then begin
  768.             s := concat(s, lf);
  769.         end;
  770.         SendData(@s[1], length(s));
  771.     end;
  772.  
  773.     procedure LineConnectionObject.LineAvailable (line: Str255);
  774.     begin
  775. {$unused(line)}
  776.     end;
  777.  
  778.     procedure LineConnectionObject.CharsAvailable;
  779.     begin
  780.         CheckLineAvailable;
  781.     end;
  782.  
  783.     procedure LineConnectionObject.CheckLineAvailable;
  784.         var
  785.             len, inbuf: longint;
  786.             p: Ptr;
  787.             s: Str255;
  788.     begin
  789.         while true do begin
  790.             inbuf := MGetHandleSize(input_buffer);
  791.             if (inbuf = 0) | (inbuf = last_check) then begin
  792.                 leave;
  793.             end;
  794.             p := input_buffer^;
  795.             len := 0;
  796.             while (len < inbuf) & (len < 255) & (p^ <> ord(lf)) & (p^ <> ord(cr)) do begin
  797.                 p := Ptr(ord(p) + 1);
  798.                 len := len + 1;
  799.             end;
  800.             if (len = 255) | ((len < inbuf) & ((p^ = ord(lf)) | (p^ = ord(cr)))) then begin
  801. {$PUSH}
  802. {$R-}
  803.                 s[0] := chr(len);
  804.                 BlockMoveData(input_buffer^, @s[1], len);
  805. {$POP}
  806.                 if (len < inbuf) & (p^ = ord(cr)) then begin
  807.                     p := Ptr(ord(p) + 1);
  808.                     len := len + 1;
  809.                 end;
  810.                 if (len < inbuf) & (p^ = ord(lf)) then begin
  811.                     p := Ptr(ord(p) + 1);
  812.                     len := len + 1;
  813.                 end;
  814.                 MMungerDelete(input_buffer, 0, len);
  815.                 LineAvailable(s);
  816.                 last_check := -1;
  817.             end else begin
  818.                 last_check := inbuf;
  819.             end;
  820.         end;
  821.     end;
  822.  
  823.     procedure IdleConnections;
  824.         var
  825.             i: integer;
  826.     begin
  827.         for i := 1 to max_connections do begin
  828.             if connections[i] <> nil then begin
  829.                 if not connections[i].timetodie then begin
  830.                     connections[i].HandleConnection;
  831.                 end;
  832.                 if connections[i].timetodie then begin
  833.                     connections[i].Destroy;
  834.                 end;
  835.             end;
  836.         end;
  837.     end;
  838.  
  839.     procedure DestroyAll( fail: Boolean );
  840.         var
  841.             i: integer;
  842.     begin
  843.         for i := 1 to max_connections do begin
  844.             if connections[i] <> nil then begin
  845.                 if fail then begin
  846.                     connections[i].Failed( kOTClientNotInittedErr );
  847.                 end;
  848.                 connections[i].Destroy;
  849.             end;
  850.         end;
  851.         max_connections := 0;
  852.     end;
  853.     
  854.     procedure FinishConnections;
  855.     begin
  856.         quiting := true;
  857.         DestroyAll( false );
  858.     end;
  859.     
  860.     procedure TransitionNotifier( up: boolean );
  861.     begin
  862.         if not up then begin
  863.             DestroyAll( true );
  864.         end;
  865.     end;
  866.     
  867.     function InitConnections( var msg: integer ): OSStatus;
  868.         var
  869.             i: integer;
  870.     begin
  871. {$unused(msg)}
  872.         DidStartup( startup_check );
  873.         TransportInstallTransitionNotifier( TransitionNotifier );
  874.         quiting := false;
  875.         for i := 1 to connections_max do begin
  876.             connections[i] := nil;
  877.         end;
  878.         max_connections := 0;
  879.         InitConnections := noErr;
  880.     end;
  881.     
  882.     procedure StartupConnections;
  883.     begin
  884.         StartupTransport;
  885.         SetStartup(InitConnections, IdleConnections, 0, FinishConnections);
  886.     end;
  887.  
  888. end.
  889.